00010	C******  SCMSS,  LNEND  *********** 12/1/75
00100		SUBROUTINE SCMSS
00105		INTEGER PWDS
00110		COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,LL,IS,IX
00300	       COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
00350	C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
00500		DIMENSION RLIST(200),NOMOR(6),WARN(6),R(10,80),ISV(5)
00550	C  /SCX/ ALSO IN WORDS, NEWR
00600		COMMON/SCX/RHY(4),JALPHA(30),RB,RC,JZ,IRHY,JD,KA,KB,IZ
00610		1/STF/RSTFAC(8),RSTJ2/FRMT/F78F(1),FA1(1),FA5(1),IREAD
00700		1/XRN/RN(4000) /ALF/INP(72),ML 
00800		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
00900		1,NFLG,IXX,ISEMI,JG,VX(50),IAMP,K,KN,M,MODE,IBLA
01100	      EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3))
01200		1,(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST),(R,RN(3001))
01300		1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4)),(IBEAM,RN(3000))
01400		1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
01410		1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
01455		1JALPHA(3)),(RMODE2,RN(3918)),(SET4,RN(3920)),(NOSET,RN(3923))
01500		DATA KSLA/'/'/,IXX/'X'/,LCNT/1/,RHY/.5,.25,.125,.0625/
01600		1,ISEMI/';'/,IBLA/' '/
01700		ISX=IS
01800	C  SAVE RN COUNTER FOR ZERO FEATURE AT 168
01900	1177	IF(JA.EQ.14)GO TO 77
01950		IF(JA.NE.144)GO TO 11
02000	77	MODE=1
02050	CC	THIS IS SET IN MSX NOW ****  RMODE2=R3
02060		TYPE 444,SET4
02100		IBEAM=-1
02200		IZ=0
02300		IREAD=0
02400	11	IF(IREAD)GO TO 2304
02500		IF(JA.NE.144)GO TO (1,2,3,4,5,69)MODE
02700	2302	IF(IREAD)GO TO 2304
02705		REREAD 80052,L,L,L,STAFF,RMODE2
02707		GO TO 2177
02708	2304	IF(IREAD.EQ.-1)REREAD 21141,L,INP
02709		IF(IREAD.EQ.-2)REREAD 2114,INP
02710	2303	TYPE 80053
02800		ACCEPT 80052,STAFF
02810	CC	IF(STAFF.NE.444)GO TO 2177
02820		REREAD 4177,RA,RB
02825		IF(RA.NE.'SP')GO TO 2177
02830	C NOW SPACER CAN BE SET AT THIS POINT
02835		SET4=RB
02840		GO TO 2303
02845	4177	FORMAT(A2,F)
02850	2177	IF(STAFF.GE.99)GO TO 690
02875	C  TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
02887		REND=0
02900		IF(IREAD)GO TO 80041
02950		IF(LOOK(L)+LOOKD(L))GO TO 101 
02960		TYPE 101,L
02970		GO TO 690
02980	101	FORMAT(' FILE NOT FOUND - ',A5)
03000		IREAD=-1
03055	C FOR 1ST TIME IN BEAMS.
03100		REWIND 22
03200		CALL IFILE(22,L)
03220	2301	IF(IREAD.EQ.-2)GO TO 2307
03300		READ(22,21141,END=68),L,INP
03305		IF(L.NE.0)GO TO 2300
03307	C  JUMP IF LINE NUMBERS
03310		IF(INP1.EQ.'O')GO TO 2307
03320		IREAD=-2
03325	C  THIS IS FOR NON-'ET' FILES WITH NO LINE NUMBS.
03330		REREAD 2114,INP
03332		GO TO 2300
03335	2307	READ(22,2114,END=68)INP
03340		IF(IREAD.EQ.-2)GO TO 2300
03345		IF(INP3.NE.ISEMI)GO TO 2307
03350		IREAD=-2
03352		READ(22,2114)INP
03355		GO TO 2307
03400	2300	IF(MODE.EQ.6)GO TO 1111
03500		IF(INP1.EQ.IBLA)GO TO 8006
03600		IF(INP1.EQ.ISEMI)GO TO 8006
03625	C  'ET' FILES MUST HAVE ';' AS 1ST CHAR.  BLANK LINES ARE IGNORED!!
03650		GO TO 6177
03700	1111	MODE=1
03800		REND=2
03900		IZ=0
04000	CC	RETURN
04200	C   ABOVE ALLOWS MORE STAVES TO BE READ
04220	168	IF(NOSET.EQ.0)RETURN
04240	CC	DO 1168 K=NIT,JIT+NIT-1
04260	CC	L=PWDS(K)
04262		L=ISX
04280	2168	RA=RN(L+1)
04300		IF(RA.GT.2)GO TO 1168
04320		N=9
04340		IF(RA.EQ.2)N=7
04360		RN(L+N)=0
04380	C  ZEROS RHYTHM OF ADDED INPUT ON SPACING STAFF
04400	CC1168	CONTINUE
04402	1168	L=L+RN(L)+3
04404		IF(L.LT.IS)GO TO 2168
04420		RETURN
04780	
04800	80053	FORMAT(' NEXT STAFF NUM='$)
05000	80052	FORMAT(F,A4,A5,2F)
05010	444	FORMAT(' SPACING STAFF =',F3.0)
05100	
05400	4	TYPE 8002
05500	330	ACCEPT 2114,N,L,INP3,INP4
05600	CC	IF(N.EQ.'G')GO TO 8024
05650		IF(N.EQ.'G')GO TO 69
05700	C  TYPE 'GO' TO PASS LATER ITEMS
05800		IF(N.EQ.'9')GO TO 99
05850		IF(N.EQ.'B')GO TO 99
05900		IF(N.EQ.'Y')GO TO 1
05925		IF(L.EQ.'B')GO TO 134
05931		IF(INP3.EQ.'B')GO TO 134
05937	C  FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
05950		IF(N.EQ.'N')GO TO 2000
05962		IF(N.NE.IBLA)GO TO 11
05975	C  PICKS UP TYPOS
06000	2000	MODE=MODE+1
06050		WRITE(21,2114)INP4
06100		GO TO 11
06130	691	FORMAT(' INPUT SAVED ON FOR21.DAT')
06140	69	END FILE 21
06145		TYPE 691
06150	690	REND=1
06175	CC	RETURN
06187		GO TO 168
06200	3	TYPE 8023
06300		GO TO 330
06400	5	TYPE 8022
06500		GO TO 330
06610	8024	CALL HYDPOG(3)
06655	C  ERASES NOTE NUMBERS
06800	C  JUMP IF NO STEM NORMALIZATION NEEDED
06900	C	IF(MODE.LT.3)GO TO 8006
07300	C   ADJUSTS NOTE STEMS, ETC.
07400	8006	MODE=MODE+1
07410		IF(MODE.NE.2)GO TO 177
07415		IF(RMODE2.EQ.2)GO TO 80041
07420	C   FOR NEW INPUT FORMAT -- TYPE 14 2 OR 144 -2 ETC.
07500	177	IF(IREAD)GO TO 2301
07600		IF(MODE.LE.5)RETURN
07620		END FILE 21
07660		TYPE 691
07700	68	REND=-1
07750	CC	RETURN
07850		GO TO 168
07900	
08300	
09000	99	IF(INP3.EQ.'9')GO TO 999
09200	C   ELSE GET ANOTHER CHANCE TO SAY 'NO'
09300	C  99=BACKUP,  999=ESCAPE
09400		MODE=MODE-1
09600		IF(MODE.EQ.0)GO TO 999
09610		IS=ISV(MODE)
09620		GO TO 11
09650	C  INSERT BACKUP ROUTINE
09700	999	REND=99
09800		RETURN
10550	C FIX BACKUPS********
10600	
10800	8008	FORMAT(' TYPE ',I2,' RHYTHMS')
10900	8002	FORMAT(' ADD BEAMS?  '$)
11000	8022	FORMAT(' ADD SLURS?  '$)
11100	8023	FORMAT(' ADD MARKS?  '$)
11200	8011	FORMAT(1XI3,' MORE RHYTHMS NEEDED'/)
11210	8015	K=IRHY-I+1
11400		TYPE 8011,K
11500		IF(IREAD)IREAD=-IREAD
11550	C  ↑↑↑↑↑ SO YOU CAN TYPE MORE LINES WHEN ERROR ON READIN.
11600	2	TYPE 8008,IRHY
12000	
12350	1	ISV(MODE)=IS
12400		CALL TYPE
12410		REREAD 4177,RA,RB
12420		IF(RA.NE.'SP')GO TO 5177
12430		SET4=RB
12440	C CAN SET SPACER HERE
12450		GO TO 1177
12600	5177	IF(INP1.EQ.IBLA) GO TO 1
12700		IF(INP1.NE.'9')GO TO 80041
12750		IF(INP2.EQ.'9')GO TO 99
12800	C  TYPE '99' TO BACK-UP
12850	80041	WRITE(21,2114)INP
12875	6177	CALL LNEND
12900		IF(MODE.GE.3)GO TO 133
13100		RETRO=-1.
13200		I=1
13300		PARENS=0
13400		MOT=0
13500	      JZ=1  
13600		IAMP=0
13700	C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
13800	      KL=0  
13900	      RA=0  
14000	2408	MLX=1
14100		L=-1
14110		IF(RMODE2.EQ.2)CALL PRESCN
14120	C   GO SORT OUT THE NEW FORMAT
14200		DO 2999 K=1,72
14300		N=INP(K)
14400		IF(N.EQ.IBLA)GO TO 2999
14500		L=0 
14600		IF(N.EQ.ISTAR)GO TO 277
14650		IF(N.NE.ISEMI)GO TO 2999
14700	C  READS 72 CHARS. INCLUDING *.
14800	277	INP(K+1)=ISEMI
14900		GO TO 1773
15000	C  --- X/Y/Z* ---  WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
15100	2999	CONTINUE
15200		IF(IREAD)GO TO 8015
15210		TYPE 6999
15220		GO TO 1
15230	6999	FORMAT(' ****** TRY AGAIN ***** ')
15300	CC	GO TO 69
15400	C   ERROR IF NO '*' OR ';' AT END OF LINE.
15500	
15600	1299	IF(JZ.NE.0)GO TO 1773
15610	7773	IF(MODE.NE.2)GO TO 377
15632		IF(RMODE2.EQ.2)GO TO 77732
15655	C  ↑↑↑↑↑↑ FOR NEW INPUT FORMAT
15700	377	IF(IREAD.EQ.0)GO TO 77731
15800	C   BYPASS IF NOT USING EDIT FILE
15900		IF(IREAD.EQ.-1)READ(22,21141),L,INP
15910		IF(IREAD.EQ.-2)READ(22,2114)INP
16000	C   TO READ 2ND LINE OF NOTE INPUT, IF NEEDED
16100		GO TO 77732
16300	77731	CALL TYPE
16350	
16400		IF(INP1.EQ.IBLA)GO TO 7773
16451		WRITE(21,2114)INP
16475	77732	CALL LNEND
16500		JM=-1
16600		JZ=0
16700		GO TO 2408
16800	C   'LISTS' MUST END WITH * 
16900	1773	JZ=0
17000		DBST=1.
17020		IF(XDBST)DBST=-DBST
17040		XDBST=0
17100	17731	ML=MLX
17200		IF(PARENS.LE.0.)GO TO 975
17300	C  PARENS=-1, OPENS; =1, CLOSES; =0, NONE
17400	3362	PARENS=0
17500		MOT=I-LMOT
17600		IF(LCNT+MOT.LT.198)GO TO 33621
17700		DATA NOMOR/30H(' NO ROOM FOR MOTIVE ',A1/)   / 
17800		TYPE NOMOR,JMOT
17900		GO TO 1
18000	33621	JLIST(LCNT+1)=MOT
18100		LCNT=LCNT+2
18200		DO 2140 JG=0,MOT-1
18300	2140	RLIST(LCNT+JG)=V(LMOT+JG)
18400		LCNT=LCNT+MOT
18500		IF(IAMP)GO TO 3013
18700	C  FOR CLOSE PARENS ON LAST ITEM
18800	C   STORE MOTIVE IN RLIST ARRAY
18900	
19000	975	DO 236 JDD=ML,72
19100		JD=JDD
19200		N=INP(JD)
19300	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC.  CAN USE 26 LABELS.
19400		IF(N.EQ.ILP)GO TO 477
19450		IF(N.EQ.IRP)GO TO 477
19475		IF(N.NE.ICOL)GO TO 2361
19500	477	INP(JD)=IBLA
19600		IF(N.NE.ICOL)GO TO 1113
19720		XDBST=-1.
19740		GO TO 5362
19750	C  GO CHANGE IT TO A SEMIC.  !!! CAN'T END LINE WITH :
19760	C  SO NEXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
19780	C  DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
19900	C  FOR 'DOUBLE STOPS'
20000	1113	L=JD-1
20100	5113	IF(INP(L).NE.IBLA)GO TO 2113
20200		L=L-1
20300		GO TO 5113
20400	2113	IF(N.EQ.')')GO TO 3361
20500	C  ONLY ONE () AS YET,  NO NESTING
20600	1140	JMOT=INP(L)
20700	C   MOTIVE NAME
20800		DO 11401 JC=1,LCNT-1
20900		IF(JMOT.NE.JLIST(JC))GO TO 11401
21000	C  FINDS DUPLICATE IDENTIFIER
21200	11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
21400		TYPE 11402,JMOT
21450		JLIST(JC)=0
21475	C  ZERO OUT PREVIOUS USE OF IDENTIFIER.
21500	11401	CONTINUE
21600		JLIST(LCNT)=JMOT
21700		PARENS=-1.
21800	C   A PARENTH IS OPEN
21900		INP(L)=IBLA
22000		LMOT=I
22100	C   LMOT IS CURRENT POINT IN V ARRAY
22200		GO TO 236
22300	3361	IF(PARENS.NE.0)GO TO 33612
22400		DATA WARN/30H(' PARENTH ERROR - GOING ON'/)/
22500		TYPE WARN
22600	33611	INP(JD)=IBLA
22700		GO TO 236
22800	33612	PARENS=1.
22900	C   SETS PARENS CLOSED FLAG
23000		GO TO 33611
23100	C   NO INVERSIONS POSSIBLE NOW
23200	2361	IF(N.NE.IAT)GO TO 5361
23300		DO 113 L=1,72
23400		K=JD+L
23500	C   K IS USED AT 240!!!
23600		JG=INP(K)
23700		IF(JG.NE.NEG)GO TO 7113
23800		RETRO=0
23900		INP(K)=IBLA
24000		GO TO 113
24100	7113	IF(JG.NE.IBLA)GO TO 4113
24200	113	CONTINUE
24300	4113	DO 6361 L=1,LCNT
24400		IF(JG.NE.JLIST(L))GO TO 6361
24500		VX1=0
24600		DO 40 M=JD+2,72
24700		JG=INP(M)
24800		IF(JG.EQ.IBLA)GO TO 40
24900		IF(JG.EQ.KSLA)GO TO 140
24950		IF(JG.EQ.ISEMI)GO TO 140
24975		IF(JG.EQ.ISTAR)GO TO 140
25000		ML=M
25100		GO TO 240
25200	40	CONTINUE
25300	240	JC=JM
25400		JM=-1
25500		INP(K)=IBLA
25600		JN=0
25700	C   MUST BE ZERO IN SCANR
25800		CALL SCANR
25900		JM=JC
26000	140	JC=1
26100		KN=L+2
26210		M=KN+JLIST(L+1)
26300		IF(RETRO)GO TO 940
26400		KN=M-1
26550		M=L+1
26600		JC=-1
26700		RETRO=-1.
26800	
26900	940	Z=RLIST(KN)
27000		IF(VX1.EQ.0)GO TO 540
27100	C  " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
27200		IF(MODE.EQ.1)GO TO 440
27300	C  MODE 1 IS NOTES, 2 IS RHY.
27400		V(I)=Z*VX1
27500		GO TO 7361
27600	440	IF(Z.EQ.85.)GO TO 540
27605		RB=VX1
27610		IF(Z)RB=-RB
27620	C NOW TRANSPOSES BY DIAT. STEPS ONLY 1000S=FLAT, 10000S=SHARP, 100000S=NAT
27630	C  NEG NUMS ARE CHORD NOTES.
27700		V(I)=Z+RB
27800		GO TO 7361
27900	540	V(I)=Z
28000	7361	I=I+1
28100		KN=KN+JC
28200		IF(KN.NE.M)GO TO 940
28300	
28400		RB=V(I-1)
28600		DO 8361 L=JD,72
28700		JG=INP(L)
28800		INP(L)=IBLA
28900		IF(JG.EQ.KSLA)GO TO 9361
29000		IF(JG.EQ.ISEMI)GO TO 93611
29200	8361	IF(JG.EQ.ISTAR)IAMP=-1
29300	9361	MLX=L
29400		IF(IAMP.EQ.0)GO TO 17731
29600		JZ=-1
29700	93611	IF(IAMP)GO TO 3013
29900		GO TO 7773
30000	6361	CONTINUE
30100		TYPE 6362,JG
30200		GO TO 11402
30300	6362	FORMAT(' MOTIVIC (',A1,') NOT FOUND')
30400	C @@@@@@@@@@@@@@@@@@@@@@@@@@
30500	5361	IF(N.NE.KSLA)GO TO 636
30600	5362	MLX=JD+1
30700		JZ=-1
30800		INP(JD)=ISEMI
30900	436	IF(INP(MLX).NE.IBLA)GO TO 103
31000		MLX=MLX+1
31100		GO TO 436
31200	636	IF(N.EQ.ISEMI)GO TO 103
31300	936	IF(N.NE.IDOT)GO TO 736
31400		L=INP(JD+1)
31500		KL=NALF(L)
31600		IF(L.LE.0)GO TO 577
31650		IF(KL.LT.0)GO TO 577
31675		IF(KL.LE.9)GO TO 236
31700	C   JUMP IF IT'S A NUMBER
31800	577	IF(MODE.EQ.2)INP(JD)=1
31900	C :::::::::******* ↑↑↑↑ MODE #?
32000		GO TO 236
32100	C   CHANGES DOTTED RHYTHMS TO '1'S.
32200	736	IF(N.NE.ISTAR)GO TO 236
32300		IAMP=-1
32400		INP(JD)=ISEMI
32600		GO TO 103
32700	236	CONTINUE
     

00200	2114	FORMAT(72A1)
00300	21141	FORMAT(I,72A1)
09900	
10000	5016	IF(IAMP.GE.0)GO TO 1299
10100		IF(PARENS.NE.0)GO TO 3362
10200	C  PARENS ARE STILL OPEN?
10300		GO TO 3013
10400	103	K=INP(ML)
10500	
10600	C   LAST SECTION
10700		IF(K.EQ.ISEMI)GO TO 1014
10800	C*********** MODE #?
10900		IF(K.NE.IBLA) GO TO 1899
11000		ML=ML+1
11100		GO TO 103
11200	1899	JN=0
11300	C   MUST BE ZERO IN SCANR
11400		CALL SCANR
11500	      IF(VX1.EQ.-99.)GO TO 4022
11600		IF(MODE.NE.2)GO TO 17
11700	C*********** MODE #?
11800	2017	IF(VX1.EQ.10000.)GO TO 17
11900	      VX1=4./VX1
12000		IF(JJ.NE.1)GO TO 2014
12100		V(I)=VX1
12200		GO TO 114
12300	2014	DO 9006 L=2,JJ
12400		IF(VX(L).EQ.0)GO TO 17
12500	9006	VX1=4./VX(L)+VX1
12600		JJ=1
12700	17	V(I)=VX1
12800		IF(JJ.LE.1)GO TO 114
12900		IF(MODE.NE.1)GO TO 171
12950		IF(VX2.EQ.0)GO TO 171
13000	C  JUMP IF RHY OR 'X 4' ETC.
13100		V(I)=-(VX1/100.+VX2/10000.)
13200	C  PACKS 2 METER NUMS INTO ONE SLOT (-.1208 = 12/8)
13310	114	I=I+1
13320		GO TO 5016
13400	171	JC=1
13500		JD=VX(JJ)-1
13525		I=I+1
13550		GO TO 5005
13650	1014	JD=1
13750		JC=1
13850	C  X4/ CREATES REP 1,4;  A/// CREATES REP 1,3;
13950		GO TO 5005
14600	4022      JC=VX2+.3
14700	      JD=VX3-.5
14800		IF(JJ.EQ.2)JD=1
14900	C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
14910	5005	N=0
14920		DO 3005 K=I-1,1,-1
14930		IF(V(K).GT.0)N=N+1
14940	3005	IF(N.EQ.JC)GO TO 4005
14950	4005	JC=I-K
14960	C  ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
14970	C  REPS WILL ONLY COUNT RHYTHMIC UNITS.!
15000	      DO 1005 K=1,JD    
15100	       NL=I+JC-1  
15200	      DO 2005 L=I,NL    
15300	2005  V(L)=V(L-JC)
15400	1005      I=I+JC  
15700	      GO TO 5016  
15800	
15900	3013	IF(MODE.NE.2)GO TO 771
15950		IF(I-1.NE.IRHY)GO TO 8015
16000	C  WRONG NUMBER OF ITEMS
16100	771	V(I)=-99.
16200		IF(MODE.NE.1)GO TO 132
16210	CCC	NIT=ITEM+1
16215	C  FOR ADDED NOTES ON SPACING STAFF
16220		CALL NOTES
16250	CCC	JIT=IZ
16275	C SAVES TOTAL OF ITEMS FOR LABEL 168
16310	67	CALL NEWR
16400		GO TO 8006
16450	132	IF(IREAD.GT.0)IREAD=-IREAD
16500		CALL RHYTH
16700	C  =50 IS RHYTHM FOR TEXT
16950		GO TO 67
16955	134	WRITE(21,2114)N,L,INP3
16960		INP3='B'
16980		INP2=0
17000	C   ACCENTS ARE IN BEAMS SUBROUTINE
17100	133	CALL BEAMS
17110		IF(MODE.EQ.3)GO TO 135
17155		IF(MODE.EQ.4)IBEAM=0
17177	C  ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
17200		GO TO 8006
17600	135	K=IS
17700		CALL NEWR
17800		IS=K
17900	C  ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
18000		GO TO 8006
18100		END